home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Source Code / C / Applications / MacPerl 5.0.3 / MacPerl Source ƒ / Perl5 / ext / DynaLoader / dl_next.xs < prev    next >
Encoding:
Text File  |  1994-12-26  |  4.1 KB  |  214 lines  |  [TEXT/MPS ]
  1. /* dl_next.xs
  2.  * 
  3.  * Platform:    NeXT NS 3.2
  4.  * Author:    Anno Siegel (siegel@zrz.TU-Berlin.DE)
  5.  * Based on:    dl_dlopen.xs by Paul Marquess
  6.  * Created:    Aug 15th, 1994
  7.  *
  8.  */
  9.  
  10. /*
  11.     And Gandalf said: 'Many folk like to know beforehand what is to
  12.     be set on the table; but those who have laboured to prepare the
  13.     feast like to keep their secret; for wonder makes the words of
  14.     praise louder.'
  15. */
  16.  
  17. /* Porting notes:
  18.  
  19. dl_next.xs is itself a port from dl_dlopen.xs by Paul Marquess.  It
  20. should not be used as a base for further ports though it may be used
  21. as an example for how dl_dlopen.xs can be ported to other platforms.
  22.  
  23. The method used here is just to supply the sun style dlopen etc.
  24. functions in terms of NeXTs rld_*.  The xs code proper is unchanged
  25. from Paul's original.
  26.  
  27. The port could use some streamlining.  For one, error handling could
  28. be simplified.
  29.  
  30. Anno Siegel
  31.  
  32. */
  33.  
  34. #include "EXTERN.h"
  35. #include "perl.h"
  36. #include "XSUB.h"
  37.  
  38. #include "dlutils.c"    /* SaveError() etc    */
  39.  
  40.  
  41. #include <mach-o/rld.h>
  42. #include <streams/streams.h>
  43.  
  44. static char * dl_last_error = (char *) 0;
  45.  
  46. NXStream *
  47. OpenError()
  48. {
  49.     return NXOpenMemory( (char *) 0, 0, NX_WRITEONLY);
  50. }
  51.  
  52. void
  53. TransferError( s)
  54. NXStream *s;
  55. {
  56.     char *buffer;
  57.     int len, maxlen;
  58.  
  59.     if ( dl_last_error ) {
  60.         safefree(dl_last_error);
  61.     }
  62.     NXGetMemoryBuffer(s, &buffer, &len, &maxlen);
  63.     dl_last_error = safemalloc(len);
  64.     strcpy(dl_last_error, buffer);
  65. }
  66.  
  67. void
  68. CloseError( s)
  69. NXStream *s;
  70. {
  71.     if ( s ) {
  72.       NXCloseMemory( s, NX_FREEBUFFER);
  73.     }
  74. }
  75.  
  76. char *dlerror()
  77. {
  78.     return dl_last_error;
  79. }
  80.  
  81. char *
  82. dlopen(path, mode)
  83. char * path;
  84. int mode; /* mode is ignored */
  85. {
  86.     int rld_success;
  87.     NXStream *nxerr = OpenError();
  88.     AV * av_resolve;
  89.     I32 i, psize;
  90.     char *result;
  91.     char **p;
  92.  
  93.     av_resolve = GvAVn(gv_fetchpv(
  94.     "DynaLoader::dl_resolve_using", FALSE, SVt_PVAV));
  95.     psize = AvFILL(av_resolve) + 3;
  96.     p = (char **) safemalloc(psize * sizeof(char*));
  97.     p[0] = path;
  98.     for(i=1; i<psize-1; i++) {
  99.     p[i] = SvPVx(*av_fetch(av_resolve, i-1, TRUE), na);
  100.     }
  101.     p[psize-1] = 0;
  102.     rld_success = rld_load(nxerr, (struct mach_header **)0, p,
  103.                 (const char *) 0);
  104.     safefree((char*) p);
  105.     if (rld_success) {
  106.     result = path;
  107.     } else {
  108.     TransferError(nxerr);
  109.     result = (char*) 0;
  110.     }
  111.     CloseError(nxerr);
  112.     return result;
  113. }
  114.  
  115. int
  116. dlclose(handle) /* stub only */
  117. void *handle;
  118. {
  119.     return 0;
  120. }
  121.  
  122. void *
  123. dlsym(handle, symbol)
  124. void *handle;
  125. char *symbol;
  126. {
  127.     NXStream    *nxerr = OpenError();
  128.     char    symbuf[1024];
  129.     unsigned long    symref = 0;
  130.  
  131.     sprintf(symbuf, "_%s", symbol);
  132.     if (!rld_lookup(nxerr, symbuf, &symref)) {
  133.     TransferError(nxerr);
  134.     }
  135.     CloseError(nxerr);
  136.     return (void*) symref;
  137. }
  138.  
  139.  
  140. /* ----- code from dl_dlopen.xs below here ----- */
  141.  
  142.  
  143. static void
  144. dl_private_init()
  145. {
  146.     (void)dl_generic_private_init();
  147. }
  148.  
  149. MODULE = DynaLoader     PACKAGE = DynaLoader
  150.  
  151. BOOT:
  152.     (void)dl_private_init();
  153.  
  154.  
  155.  
  156. void *
  157. dl_load_file(filename)
  158.     char *    filename
  159.     CODE:
  160.     int mode = 1;
  161.     DLDEBUG(1,fprintf(stderr,"dl_load_file(%s):\n", filename));
  162.     RETVAL = dlopen(filename, mode) ;
  163.     DLDEBUG(2,fprintf(stderr," libref=%x\n", RETVAL));
  164.     ST(0) = sv_newmortal() ;
  165.     if (RETVAL == NULL)
  166.     SaveError("%s",dlerror()) ;
  167.     else
  168.     sv_setiv( ST(0), (IV)RETVAL);
  169.  
  170.  
  171. void *
  172. dl_find_symbol(libhandle, symbolname)
  173.     void *        libhandle
  174.     char *        symbolname
  175.     CODE:
  176.     DLDEBUG(2,fprintf(stderr,"dl_find_symbol(handle=%x, symbol=%s)\n",
  177.         libhandle, symbolname));
  178.     RETVAL = dlsym(libhandle, symbolname);
  179.     DLDEBUG(2,fprintf(stderr,"  symbolref = %x\n", RETVAL));
  180.     ST(0) = sv_newmortal() ;
  181.     if (RETVAL == NULL)
  182.     SaveError("%s",dlerror()) ;
  183.     else
  184.     sv_setiv( ST(0), (IV)RETVAL);
  185.  
  186.  
  187. void
  188. dl_undef_symbols()
  189.     PPCODE:
  190.  
  191.  
  192.  
  193. # These functions should not need changing on any platform:
  194.  
  195. void
  196. dl_install_xsub(perl_name, symref, filename="$Package")
  197.     char *    perl_name
  198.     void *    symref 
  199.     char *    filename
  200.     CODE:
  201.     DLDEBUG(2,fprintf(stderr,"dl_install_xsub(name=%s, symref=%x)\n",
  202.         perl_name, symref));
  203.     ST(0)=sv_2mortal(newRV((SV*)newXS(perl_name, (void(*)())symref, filename)));
  204.  
  205.  
  206. char *
  207. dl_error()
  208.     CODE:
  209.     RETVAL = LastError ;
  210.     OUTPUT:
  211.     RETVAL
  212.  
  213. # end.
  214.